home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 41
/
Aminet 41 (2001)(Schatztruhe)[!][Feb 2001].iso
/
Aminet
/
gfx
/
edit
/
AmiCAD_2.07.lha
/
AmiCAD
/
ARexx
/
grille.AmiCAD
< prev
next >
Wrap
Text File
|
2000-11-09
|
5KB
|
206 lines
/* Création d'une grille quadrillée
$VER: Grille.AmiCAD 1.06 (© R.Florac, 9/11/2000)
Version 1.00 ©R.Florac, Mardi 3 Mars 1998
Version 1.01, 25 avril 1998 (utilisation d'un rectangle pour définir la zone recevant la grille)
Version 1.02, 12 novembre 1998 (correction bug variables x0 et y0)
Version 1.03, 29 Mars 1999 (ajout GETZONE)
Version 1.04, 22 Mai 1999 (Modification DRAWMODE)
Version 1.05, 13 avril 2000 (Adaptation version 2.05)
Version 1.06, 9 novembre 2000 (Localisation anglais/français) */
options results /* indispensable pour récupérer le résultat des macros */
signal on error /* pour l'interception des erreurs */
signal on syntax
'LANGUAGE'
if result="français.language" then fr=1
else fr=0
'WWIDTH'; lt = result
'WHEIGHT'; ht=result
clip=-1
FIRSTSEL; obj=result
if obj>0 then do
'TYPE(FIRSTSEL)'; type=result
if type=22 then do
'CLIPUNIT(5)'; clip=result
'COORDS(FIRSTSEL)'; coords=result
PARSE VAR coords x0 ',' y0 ',' x1 ',' y1
xg=minima(x0,x1); xd=maxima(x0,x1)
yh=minima(y0,y1); yb=maxima(y0,y1)
l=xd-xg+1; h=yb-yh+1
'NEXTSEL('obj')'; obj=result
end
end
else obj=1
if obj>0 then do
if fr=1 then 'GETZONE("Dessinez un rectangle avec la souris")'
else 'GETZONE("Draw a box with the mouse")'
coords=result
if coords="" then call quitter
PARSE VAR coords x0 ',' y0 ',' x1 ',' y1
xg=minima(x0,x1); xd=maxima(x0,x1)
yh=minima(y0,y1); yb=maxima(y0,y1)
l=xd-xg+1; h=yb-yh+1
end
if fr=1 then 'ASKNUM("Axe horizontal"+CHR(10)+"Nombre de décades?",1)'
else 'ASKNUM("Horizontal axis"+CHR(10)+"Number of decades?",1)'
ndh = result
if ndh<=0 then call quitter
if fr=1 then 'SELECT("Type d''échelle"+CHR(10)+"1- Linéaire"+CHR(10)+"2- Logarithmique"+CHR(10)+"3- Antilogarithmique")'
else 'SELECT("Scale type"+CHR(10)+"1- Linear"+CHR(10)+"2- Logarithmic"+CHR(10)+"3- Antilog")'
tt=result
x0=xg; y0=yh; y1=yh+h; x1=xg+ndh*(l%ndh) /* Version 1.02 */
'SAVEALL'
if clip>=0 then 'MENU("Cut")'
/* Tracé des lignes verticales */
select
when tt=1 then do
/* Tracé des lignes verticales */
do i=1 to ndh
x2 = (x0)+i*(l/ndh)
x2 = x2%1
'DRAWMODE(-1)'
do c=1 to 9
xc = x2-(l/ndh)/10*c
xc=xc%1
'DRAW('xc','y0','xc','y1')'
end
'DRAWMODE(-2):DRAW('x2','y1','x2','y0')'
end
end
when tt=2 then do
if ~show('L','rexxmathlib.library') then
call addlib('rexxmathlib.library',0,-30)
/* Tracé des lignes verticales */
x2=x0
do i=1 to ndh
'DRAWMODE(-1)'
do c=2 to 9
xc=(l/ndh)*log10(c)
xc=(x2+xc)%1
'DRAW('xc','y0','xc','y1')'
end
x2 = (x0)+i*(l/ndh)
x2 = x2%1
'DRAWMODE(-2):DRAW('x2','y1','x2','y0')'
end
end
when tt=3 then do
if ~show('L','rexxmathlib.library') then
call addlib('rexxmathlib.library',0,-30)
x2=x1
do i=1 to ndh
'DRAWMODE(-2):DRAW('x2','y1','x2','y0')'
'DRAWMODE(-1)'
do c=2 to 9
xc=(l/ndh)*log10(c)
xc=(x2-xc)%1
'DRAW('xc','y0','xc','y1')'
end
x2 = (x1)-i*(l/ndh)
x2 = x2%1
end
end
otherwise call quitter
end
if fr=1 then 'ASKNUM("Axe vertical"+CHR(10)+"Nombre de décades?",1)'
else 'ASKNUM("Vertical axis"+CHR(10)+"Number of decades?",1)'
ndv = result
if ndv<=0 then call quitter
y1=y0+h
x1=x0+ndh*(l%ndh)
/* Tracé du contour */
'DRAWMODE(-2):DRAW('x0','y0','x1','y0'):DRAW('x0','y1','x0','y0')'
if fr=1 then 'SELECT("Type d''échelle"+CHR(10)+"1- Linéaire"+CHR(10)+"2- Logarithmique"+CHR(10)+"3- Antilogarithmique")'
else 'SELECT("Scale type"+CHR(10)+"1- Linear"+CHR(10)+"2- Logarithmic"+CHR(10)+"3- Antilog")'
tt=result
/* Tracé des lignes horizontales */
select
when tt=1 then do
do i=1 to ndv
y2 = (y0)+i*(h/ndv)
y2 = y2%1
'DRAWMODE(-1)'
do c=1 to 9
yc = y2-(h/ndv)/10*c
yc=yc%1
'DRAW('x0','yc','x1','yc')'
end
'DRAWMODE(-2):DRAW('x0','y2','x1','y2')'
end
end
when tt=2 then do
if ~show('L','rexxmathlib.library') then
call addlib('rexxmathlib.library',0,-30)
y2=y1
do i=1 to ndv
'DRAWMODE(-2):DRAW('x0','y2','x1','y2')'
'DRAWMODE(-1)'
do c=2 to 9
yc=(h/ndv)*log10(c)
yc=(y2-yc)%1
'DRAW('x0','yc','x1','yc')'
end
y2 = y1-i*(h/ndv)
y2 = y2%1
end
end
when tt=3 then do
if ~show('L','rexxmathlib.library') then
call addlib('rexxmathlib.library',0,-30)
y2=y0
do i=1 to ndv
'DRAWMODE(-1)'
do c=2 to 9
yc=(h/ndv)*log10(c)
yc=(y2+yc)%1
'DRAW('x0','yc','x1','yc')'
end
y2 = (y0)+i*(h/ndv)
y2 = y2%1
'DRAWMODE(-2):DRAW('x0','y2','x1','y2')'
end
end
otherwise call quitter
end
call quitter
minima: procedure
parse arg v1,v2
if v1<v2 then return v1
return v2
end
maxima: procedure
parse arg v1,v2
if v1>v2 then return v1
return v2
end
quitter: procedure expose clip
if clip>=0 then 'CLIPUNIT('clip')'
exit
/* Traitement des erreurs, interruption du programme */
syntax:
erreur=RC
if fr=1 then 'MESSAGE("Script grille.AmiCAD"+CHR(10)+"Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
else 'MESSAGE("Grille.AmiCAD Script"+CHR(10)+"Syntax error"+CHR(10)+"in line 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
call quitter
error:
if fr=1 then 'MESSAGE("Script grille.AmiCAD"+CHR(10)+"Erreur en ligne 'SIGL'")'
else 'MESSAGE("Grille.AmiCAD Script"+CHR(10)+"Error in line 'SIGL'")'
call quitter